home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue31 / construc / ENGINE.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-02-06  |  1.9 KB  |  76 lines
  1. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Z-}
  2. unit Engine;
  3. interface
  4.  
  5.   function Diff(WordA,WordB: ShortString): Integer;
  6.  
  7. implementation
  8. uses
  9.   SysUtils;
  10.  
  11.   procedure SortLetters(var WordA: ShortString);
  12.   var
  13.     i,j: Integer;
  14.     tmp: Char;
  15.   begin
  16.     for i:=1 to Length(WordA) do
  17.     begin
  18.       for j:=Length(WordA) downto i+1 do
  19.       begin
  20.         if WordA[i] > WordA[j] then
  21.         begin
  22.           tmp := WordA[i];
  23.           WordA[i] := WordA[j];
  24.           WordA[j] := tmp
  25.         end
  26.       end
  27.     end
  28.   end {SortLetters};
  29.  
  30.   function Diff(WordA,WordB: ShortString): Integer;
  31.   { returns 0, 1 or more characters difference }
  32.   var
  33.     i,j: Integer;
  34.     OK: Boolean;
  35.   begin
  36.     WordA := UpperCase(WordA);
  37.     WordB := UpperCase(WordB);
  38.     if Length(WordA) <> Length(WordB) then
  39.     begin
  40.       if Length(WordB) > Length(WordA) then Result := Diff(WordB,WordA)
  41.       else
  42.       if Length(WordA) < (Length(WordB)+2) then { no more than one letter? }
  43.       begin
  44.         i := 1;
  45.         repeat
  46.           OK := False;
  47.           for j:=1 to Length(WordB) do
  48.             OK := OK OR (WordA[i] = WordB[i]);
  49.           if not OK then Delete(WordA,i,1)
  50.                     else Inc(i)
  51.         until (i > Length(WordA)) or (Length(WordA) = Length(WordB));
  52.         if Length(WordA) = Length(WordB) then
  53.           Result := 1 + Diff(WordA,WordB)
  54.         else
  55.           Result := 255 { no compare possible }
  56.       end
  57.       else
  58.         Result := 255 { no sensible compare possible }
  59.     end
  60.     else
  61.     begin
  62.       Result := 0;
  63.       for i:=1 to Length(WordA) do
  64.         if WordA[i] <> WordB[i] then Result := Result + 1;
  65.       if Result > 1 then { two letters replaced?? }
  66.       begin
  67.         SortLetters(WordA);
  68.         SortLetters(WordB);
  69.         Result := 1;
  70.         for i:=1 to Length(WordA) do
  71.           if WordA[i] <> WordB[i] then Result := Result + 1
  72.       end
  73.     end
  74.   end {Diff};
  75. end.
  76.